SPACE 2/SPACE - Library 2 - Volume 1.iso/program/18/forthsup/aes.fth

Text File | 1986-09-18 | 10.2 KB | 316 lines

\ GEM AES Interfaces
\
\ Written by Timothy Huang and briefly hacked by Mitch Bradley.
\
\ This is pretty low-level stuff, and it hasn't been extensively used
\ yet, so good luck.
\
\ For this to work, you have to rename FORTH.TOS to FORTH.PRG and restart
\ Forth.

code aescall (s addr --- )      \ <addr> is the address of AES's
                                \ PARAMETER.BLOCK
        sp )+ d1 lmove          \ pass <addr> to d1.long
        th 1e #  sp -)  movem   \ save a3 thru a6
        200 # d0 wmove          \ pass 200 to d0.word
        2 trap                  \ do it
        sp )+  th 78 #  movem   \ restore a6 thru a3
c;

: l.array                       \ to create long size array
        create /l* allot        \ n L.ARRAY <name>
        does>                   \ (s index --- addr )
               swap la+  ;
: w.array                       \ to create word size array
        create /w* allot        \ n W.ARRAY <name>
        does>                   \ (s index --- addr )
               swap wa+  ;

6  l.array parameter.block      \ AES parameter block array
5  w.array aes-control          \ AES control array
15 w.array aes-global           \ AES global array, 30 bytes long
16 w.array aes-int_in           \ AES integer input array
7  w.array aes-int_out          \ AES integer output array
3  l.array aes-addr_in          \ AES address input array
1  l.array aes-addr_out         \ AES address output array

: aes-set (s from.addr --- )    \ set aes-control array
        0 aes-control  10 cmove ;

: call-aes (s --- )             \ call the aes hook
        0 parameter.block aescall ;

: init-a.p.b (s --- )           \ initialize aes parameter block
        0 aes-control   0 parameter.block token!     \ move addresses of
        0 aes-global    1 parameter.block token!     \ the arrays into
        0 aes-int_in    2 parameter.block token!     \ the PARAMETER.BLOCK
        0 aes-int_out   3 parameter.block token!
        0 aes-addr_in   4 parameter.block token!
        0 aes-addr_out  5 parameter.block token!   ;


\ ***** The followings are only the very fundamental hooks between
\       FORTH and the GEM AES.  Each function may need some real parameters
\       to be placed in the right cells of the right array within the higher
\       level definitions.

: aes-opc (s n1 n2 n3 n4 n5 --- )   \ to define all aes function names
        create w, w, w, w, w,
        does> aes-set  call-aes  ;


\ ***** Application Library Routines
\
0 0 1 0 10      aes-opc appl_init
0 1 1 2 11      aes-opc appl_read
0 1 1 2 12      aes-opc appl_write
0 1 1 0 13      aes-opc appl_find
0 1 1 2 14      aes-opc appl_tplay
0 1 1 1 15      aes-opc appl_trecord
0 0 1 0 19      aes-opc appl_exit

\ ***** Event Library Routines
\
0 0 1 0 20      aes-opc evnt_keybd
0 0 5 3 21      aes-opc evnt_button
0 0 5 5 22      aes-opc evnt_mouse
0 1 1 0 23      aes-opc evnt_mesag
0 0 1 2 24      aes-opc evnt_timer
0 1 7 16 25     aes-opc evnt_multi
0 0 1 2 26      aes-opc evnt_dclick

\ ***** Menu Library Routines
\
0 1 1 1 30      aes-opc menu_bar
0 1 1 2 31      aes-opc menu_icheck
0 1 1 2 32      aes-opc menu_ienable
0 1 1 2 33      aes-opc menu_tnormal
0 2 1 1 34      aes-opc menu_text
0 1 1 1 35      aes-opc menu_register

\ ***** Object Library Routines
\
0 1 1 2 40      aes-opc objc_add
0 1 1 1 41      aes-opc objc_delete
0 1 1 6 42      aes-opc objc_draw
0 1 1 4 43      aes-opc objc_find
0 1 3 1 44      aes-opc objc_offset
0 1 1 2 45      aes-opc objc_order
0 1 2 4 46      aes-opc objc_edit
0 1 1 8 47      aes-opc objc_change

\ ***** Form Library Routines
\
0 1 1 1 50      aes-opc form_do
0 0 1 9 51      aes-opc form_dial
0 1 1 1 52      aes-opc form_alert
0 0 1 1 53      aes-opc form_error
0 1 5 0 54      aes-opc form_center

\ ***** Graphics Library Routines
\
0 0 3 4 70      aes-opc graf_rubberbox
0 0 3 8 71      aes-opc graf_dragbox
0 0 1 6 72      aes-opc graf_movebox
0 0 1 8 73      aes-opc graf_growbox
0 0 1 8 74      aes-opc graf_shrinkbox
0 0 1 4 75      aes-opc graf_watchbox
0 1 1 3 76      aes-opc graf_slidebox
0 0 5 0 77      aes-opc graf_handle
0 1 1 1 78      aes-opc graf_mouse
0 0 5 0 79      aes-opc graf_mkstate

\ ***** Scrap Library Routines
\
0 1 1 0 80      aes-opc scrp_read
0 1 1 0 81      aes-opc scrp_write

\ ***** File Selector Library Routines
\
0 2 2 0 90      aes-opc fsel_input

\ ***** Window Library Routines
\
0 0 1 5 100     aes-opc wind_create
0 0 1 5 101     aes-opc wind_open
0 0 1 1 102     aes-opc wind_close
0 0 1 1 103     aes-opc wind_delete
0 0 5 2 104     aes-opc wind_get
0 0 1 6 105     aes-opc wind_set
0 0 1 2 106     aes-opc wind_find
0 0 1 1 107     aes-opc wind_update
0 0 5 6 108     aes-opc wind_calc

\ ***** Resource Library Routines
\
0 1 1 0 110     aes-opc rsrc_load
0 0 1 0 111     aes-opc rsrc_free
1 0 1 2 112     aes-opc rsrc_gaddr
0 1 1 2 113     aes-opc rsrc_saddr
0 1 1 1 114     aes-opc rsrc_obfix

\ ***** Shell Library Routines
\
0 2 1 0 120     aes-opc shel_read
0 2 1 3 121     aes-opc shel_write
0 1 1 0 124     aes-opc shel_find
0 3 1 0 125     aes-opc shel_envrn

\ ***** Application initialize
\

: app-init ( --- )
        init-a.p.b
        appl_init  ;

\ ***** Some higher level window words
\
\ These are some easy samples of using the GEM AES.
\ Using others may not be so simple. For example, in order to
\ use the Resource Library, you must first shrink the ( FORTH )
\ system memory to free up some spaces for the loading of resource
\ file, which will be loaded ABOVE (on top of) the end of FORTH.
\ The shrinking may be done with ?shrink-memory.
\ This doesn't work if EMACS is resident, because EMACS takes up the
\ rest of the available memory that Forth doesn't use.  (You can get
\ rid of EMACS with unload-emacs if you've been editing.)

: int_in_w!  aes-int_in w! ;
: int_in_l!  aes-int_in l! ;

variable window.handle
: select-window  ( window-handle -- ) window.handle ! ;
: set-handle ( -- )  window.handle @  0 int_in_w! ;

: window-create (s x y w h type --- window.handle )
        0 int_in_w!
        4 int_in_w!
        3 int_in_w!
        2 int_in_w!
        1 int_in_w!
        wind_create
        0 aes-int_out w@ select-window ;

: window-reset (s -- )   \ sets x y w h back for open
        set-handle
        7 1 int_in_w!
        wind_get
        1 aes-int_out  1 aes-int_in  8 cmove  ;

: window-open (s -- )    \ open a window
        window-reset
        wind_open  ;

: window-close (s -- )   \ close a window
        set-handle
        wind_close  ;

: window-delete (s -- )  \ delete a window
        set-handle
        wind_delete  ;

: >>cstr  ( addr len -- cstr ) fstrbuf pack cstr ;
: window-name (s addr len -- )        \ name a  window
   >>cstr  set-handle   2 1 int_in_w!  2 int_in_l!   wind_set
;

: window-info (s string -- )        \ name a  window
   >>cstr  set-handle   3 1 int_in_w!  2 int_in_l!   wind_set
;

: window-work (s -- )     \ aes-int_out contains xywh of work
   set-handle   4 1 int_in_w!  wind_get
;

\ ########### Usage Examples ############

\ To create a window :  <x> <y> <w> <h> <parts> window-create
\    This will create a window using the provided parameters.  However,
\    it does not show the window.  Return with that window selected.
\    See AES manual for the <parts> definition. If <parts> = 4095 (dec),
\    then, you will get a window with all possible components.
\
\    When a window is created, it is assigned a "window-handle", which
\    is a small number used to identify that window.  The handle is
\    stored into a variable "window.handle".  The other window functions
\    use this variable to determine which window to use.  You can change
\    this variable with  <handle> select-window
\
\ To show a window :        erase-screen  ( clear the CRT first )
\                window-open
\    This will clear the CRT and then display the window.
\    Don't use window-open on a window that is already open, or the
\    system will crash.
\
\ To close (or delete) a window    :
\        window-close (or window-delete)
\    This will close (delete) the opened window from CRT.
\    Don't use window-close on a window that is already closed, or the
\    system will crash.
\
\ To switch between windows :
\    <window-handle> select-window     window-open
\
\ To put a name into a window's title bar :
\    " My Window"  window-name
\
\ To put a string into a window's information bar :
\    " A bunch of stuff"  window-info

\ Mouse shapes definitions

0   constant arrow
1   constant i-bar
2   constant bee
3   constant pointing
4   constant hand
5   constant thin+
6   constant thick+
7   constant outline+
255 constant user.mouse        \ You must define the user mouse first !!!!!!!

: mouse (s shape --- )      \ set mouse according to <shape>
    0 int_in_w!
        graf_mouse  ;

\ Mouse Examples :
\ arrow mouse
\ i-bar mouse
\ bee mouse
\ hand mouse
\ pointing mouse
\ thin+ mouse
\ thick+ mouse
\ outline+ mouse
\ *** Note: Do not use " user.mouse ", unless you have first defined
\ ***       your own mouse shape.
\ ***        See AES manual regarding to this subject for details.

\ File Selection Input

\ Tim says:
\ This definition will work. But watch for the following things:
\   (1) <path> and <file> must be selected carefully.  At this moment,
\     I am not very clear on what the AES manual means. I stuffed the
\     <path> with <pad> and <file> with <pad> [ after making a " get
\     current path name " ( GEMDOS function 47 : <drive#> <pad> d_getpath )].
\   (2) You must have mouse action enabled ( how to do this ???? ),
\    so that you can interact with the input selection.
\    Otherwise, it will be waiting for some mouse actions
\    which it will NEVER get.  This means after the nice box is drawn, it
\    will hang the system.
\   (3) Some times, the above method will not show the nice box, but
\     returns 1 & 0, which indicate successful operation and cancel
\    button was selected.  I think this must be the wrong input
\    parameters and the mouse action enable problems.

: get.file ( path file --- return button )
    1 aes-addr_in !
    0 aes-addr_in !
    fsel_input
    0 aes-int_out w@  1 aes-int_out w@ ;

user-state
init-a.p.b
app-init